home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / Bonus / Plasmatech / ptscp_examples.exe / %MAINDIR% / Examples / NonShellNodes / Delphi / FMain.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2001-08-31  |  7.2 KB  |  239 lines
  1. unit FMain;
  2. { See readme.txt for overview. Comments can be found with each method. }
  3.  
  4. interface
  5.  
  6. uses
  7.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ShellApi,
  8.   StdCtrls, ComCtrls, Menus, Registry,
  9.   UPTSplitter, UPTFrame, UPTShellUtils, UPTShell95, UPTTreeList, UPTShellControls;
  10.   
  11. type
  12.   TFrmMain = class(TForm)
  13.     PTSplitter1: TPTSplitter;
  14.     PTShellTree1: TPTShellTree;
  15.     PTShellList1: TPTShellList;
  16.     MainMenu1: TMainMenu;
  17.     File1: TMenuItem;
  18.     Exit1: TMenuItem;
  19.     Test1: TMenuItem;
  20.     Memo1: TMemo;
  21.     PTFrame1: TPTFrame;
  22.     Registercustomicon1: TMenuItem;
  23.     procedure PTShellTree1Change(Sender: TObject; Node: TTreeNode);
  24.     procedure PTShellList1AddItem(aSender: TObject;
  25.       aParentIShf: IShellFolder; aParentAbsIdList,
  26.       aItemRelIdList: PItemIDList; aAttribs: Integer;
  27.       var afAllowAdd: LongBool);
  28.     procedure FormCreate(Sender: TObject);
  29.     procedure Exit1Click(Sender: TObject);
  30.     procedure Registercustomicon1Click(Sender: TObject);
  31.     procedure FormDestroy(Sender: TObject);
  32.     procedure PTShellList1FillComplete(Sender: TObject);
  33.     procedure PTShellList1DblClickOpen(aSender: TObject;
  34.       var afHandled: Boolean);
  35.   private
  36.   public
  37.     { Public declarations }
  38.   end;
  39.  
  40. var
  41.   FrmMain: TFrmMain;
  42.  
  43. implementation
  44.  
  45. {$R *.DFM}
  46.  
  47.  
  48. type TMyObj = class FMyData: String; end;  // Example class associated with non-shell nodes.
  49.  
  50. const NONSHELLKEY = '__nonshell1';
  51.  
  52. var gNonShellKeyRegistered: Boolean = FALSE;
  53.  
  54.  
  55. procedure TFrmMain.Exit1Click(Sender: TObject);
  56. begin
  57.   Close;
  58. end;
  59.  
  60.  
  61. {
  62.   The non-shell items for the shell tree are added here.
  63. }
  64. procedure TFrmMain.FormCreate(Sender: TObject);
  65. var n1, n2: TTreeNode;
  66.     img: Integer;
  67. begin
  68.   img := ShellGetIconIndexFromExt( '.txt', SHGFI_SMALLICON );
  69.     {Pick an icon. We can only use system image-list icons. See below for a way of adding custom
  70.      icons to the system image list.}
  71.  
  72.   n1 := PTShellTree1.Items.AddFirst( nil, 'Hello!' );
  73.   n1.ImageIndex := img;
  74.   n1.SelectedIndex := img;
  75.   n1.Data := TMyObj.Create;
  76.   TMyObj(n1.Data).FMyData := n1.Text;
  77.  
  78.   n2 := PTShellTree1.Items.AddChild( n1, 'World!' );
  79.   n2.ImageIndex := img;
  80.   n2.SelectedIndex := img;
  81.   n2.Data := TMyObj.Create;
  82.   TMyObj(n2.Data).FMyData := n2.Text;
  83.  
  84.   n1.Expand( TRUE );
  85.     {There are a few rules when assigning non TPTShTreeData objects to the Data property of tree nodes.
  86.  
  87.      1. The item must be a class. You cannot assign integers, memory allocated with GetMem or New or
  88.         anything else. It must be a class.
  89.      2. It must be unique instance of a class.
  90.      3. The class will be automatically freed. The shell tree effectively become the owner of the object.
  91.  
  92.      Also note that you shouldn't assign objects to the Data property of shell nodes. Instead use the Data
  93.      property of the TPTShTreeData object. eg.
  94.  
  95.        PTShellTree1.GetDataFromNode(MyTreeNode).Data := TMyObj.Create;
  96.  
  97.      In this case none of the non-shell node restrictions apply - you can assign non-classes.
  98.      However, you must free the object yourself in the OnDeleteItem event handler. eg.
  99.  
  100.        procedure TFrmMain.PTShellTree1DeleteItem(aSender: TObject;
  101.          aNode: TTreeNode; aShTreeData: TPTShTreeData);
  102.        begin
  103.          TObject(aShTreeData.Data).Free
  104.        end;
  105.     }
  106.   n1.MakeVisible;
  107. end;
  108.  
  109.  
  110. {
  111.   This method is called when the selection changes in the shell tree.
  112.  
  113.   This method checks to see if the newly selected node is a shell or non-shell node.
  114.   If it is a non-shell node then the shell list is hidden and a panel is shown.
  115. }
  116. procedure TFrmMain.PTShellTree1Change(Sender: TObject; Node: TTreeNode);
  117. var f: Boolean;
  118. begin
  119.   f := Node.Selected and (TObject(node.Data) is TMyObj);
  120.   PTShellList1.Visible := not f;
  121.   PTFrame1.Visible := f;
  122.   if f then
  123.     PTFrame1.Caption := 'Non-Shell Node - "' + (TObject(node.Data) as TMyObj).FMyData + '"';
  124. end;
  125.  
  126.  
  127. {
  128.   This method is called for before every item is added to the shell list.
  129.   The non-shell item is added here, above any other items.
  130. }
  131. procedure TFrmMain.PTShellList1AddItem(aSender: TObject;
  132.   aParentIShf: IShellFolder; aParentAbsIdList, aItemRelIdList: PItemIDList;
  133.   aAttribs: Integer; var afAllowAdd: LongBool);
  134. begin
  135.  {Insert a non-shell item as the first item.}
  136.   if PTShellList1.Items.Count = 0 then
  137.     with PTShellList1.Items.Add do
  138.     begin
  139.       Caption := 'Go up';
  140.       if gNonShellKeyRegistered then
  141.         ImageIndex := ShellGetIconIndexFromExt( '.'+NONSHELLKEY, 0 );
  142.     end;
  143. end;
  144.  
  145.  
  146. {
  147.   If no items are added to the list, AddItem won't be called. FillComplete will be called
  148.   in all cases though.
  149. }
  150. procedure TFrmMain.PTShellList1FillComplete(Sender: TObject);
  151. begin
  152.   if PTShellList1.Items.Count = 0 then
  153.     with PTShellList1.Items.Add do
  154.     begin
  155.       Caption := 'Go up';
  156.       if gNonShellKeyRegistered then
  157.         ImageIndex := ShellGetIconIndexFromExt( '.'+NONSHELLKEY, 0 );
  158.     end;
  159. end;
  160.  
  161.  
  162. {
  163.   This method implements the event handler for the DblClickOpen event which is
  164.   called if the user double-clicks or presses enter on a non-folder item.
  165. }
  166. procedure TFrmMain.PTShellList1DblClickOpen(aSender: TObject;
  167.   var afHandled: Boolean);
  168. begin
  169.   if Assigned(PTShellList1.Selected) and (PTShellList1.Selected.Index = 0) then
  170.     PTShellList1.GoUp(1);
  171.   afHandled := TRUE;
  172. end;
  173.  
  174.  
  175.  
  176. {
  177.   The next two methods assign a custom icon (not already used by a registered file extension) to the
  178.   non-shell item in the list view (at index 0).
  179.  
  180.   The procedure is to add a dummy file-type to the registry that uses the desired icon. Then
  181.   get the index of that icon for the dummy file-type and set that non-shell item's ImageIndex
  182.   property to that.
  183.  
  184.   The FormDestroy method just cleans up after us.
  185.  
  186.   A more robust implementation would check if the dummy key already exists. If so, try a different
  187.   key etc.
  188. }
  189. procedure TFrmMain.Registercustomicon1Click(Sender: TObject);
  190.   procedure RegFail;
  191.   begin
  192.     raise Exception.Create( 'Failed creating registry key' );
  193.   end;
  194. var r: TRegistry;
  195. begin
  196.   ShowMessage( 'This will temporarily register a file type with an icon and use that icon for '+
  197.                'the non-shell item in the list view.' );
  198.   r := TRegistry.Create;
  199.   try
  200.     r.RootKey := HKEY_CLASSES_ROOT;
  201.     if not r.OpenKey( '.'+NONSHELLKEY, TRUE ) then RegFail;
  202.     r.WriteString( '', NONSHELLKEY );
  203.     r.CloseKey;
  204.  
  205.     if not r.OpenKey( NONSHELLKEY, TRUE ) then RegFail;
  206.     r.WriteString( '', 'Temporary key for Plasmatech Shell Control Pack Non-Shell Nodes demo' );
  207.     if not r.OpenKey( 'DefaultIcon', TRUE ) then RegFail;
  208.     r.WriteString( '', ExtractFilePath(Application.ExeName)+'goup.ico' );
  209.     r.CloseKey;
  210.  
  211.     gNonShellKeyRegistered := TRUE;
  212.   finally
  213.     r.Free;
  214.   end;
  215.  
  216.   PTShellList1.Items[0].ImageIndex := ShellGetIconIndexFromExt( '.'+NONSHELLKEY, 0 );
  217. end;
  218.  
  219.                              
  220. {
  221.   Clean up any registry mess.
  222. }
  223. procedure TFrmMain.FormDestroy(Sender: TObject);
  224. var r: TRegistry;
  225. begin
  226.   r := TRegistry.Create;
  227.   try
  228.     r.RootKey := HKEY_CLASSES_ROOT;
  229.     r.DeleteKey( NONSHELLKEY );
  230.     r.DeleteKey( '.'+NONSHELLKEY );
  231.   finally
  232.     r.Free;
  233.   end;
  234. end;
  235.  
  236.  
  237. end.
  238.  
  239.